home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 210 / applic / recipe.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-12  |  21.7 KB  |  774 lines
  1. Program recipes;
  2.  
  3. {$I gemsubs.pas}
  4. {$I auxsubs.pas}
  5.  
  6. TYPE    efields = ARRAY[1..30] of integer;
  7.         short_fields  = ARRAY[1..14] of STRING[36];
  8.         long_fields = ARRAY[1..9] of STRING[74];
  9.         titles = ARRAY[1..5,1..20] of integer;
  10.         title_data = ARRAY[1..5,1..20] of STRING[36];
  11.         m_titles = ARRAY[1..5,1..20] of STRING[20];
  12.         numstrgs = ARRAY[1..40] of STRING[2];
  13.         printtype = (Pica,Cond);
  14.                         
  15. VAR
  16.         wind_title      :       Window_Title;
  17.  
  18.         msg             :       Message_Buffer;
  19.  
  20.         a_menu          :       Menu_Ptr;
  21.  
  22.         Info_Box        :       Dialog_Ptr;
  23.  
  24.         data_box        :       Dialog_Ptr;
  25.  
  26.         disk,printer    :       text;
  27.  
  28.         fname,fname2,flder    :       STRING[80];
  29.  
  30.         efield          :       efields;
  31.  
  32.         teststrg        :       STRING[255];
  33.  
  34.         short_field     :       short_fields;
  35.         
  36.         long_field      :       long_fields;
  37.         
  38.         title           :       titles;
  39.         
  40.         title_dat       :       title_data;
  41.         
  42.         m_title         :       m_titles;
  43.         
  44.         numstrg         :       numstrgs;
  45.         
  46.         long_strg       :       STRING[74];
  47.         
  48.         pnttype         :       printtype;
  49.         
  50.         codes           :       file of integer;
  51.  
  52.         test,drive      :       short_integer;
  53.         
  54.         bnk,sect        :       STRING[12];
  55.  
  56.         folname         :       C_String;
  57.         
  58.         title0,title1,title2,title3,title4,title5,item11,smf,
  59.         sf,info_item,save_btn,ex_btn,pnt_btn,ok_button,box,
  60.         dummy,event_val,windtype,big_window,event,item12,item13,
  61.         hx,hy,hw,hh,xm,ym,wm,hm,cw,ch,bw,bh,c1,c2,pc1,pc2,item14,
  62.         x,y,section,number,item15,item16,item17,item18,pc3,pc4,
  63.         item19,item20,item21,item22,item23,bank,bx,item24,item25,
  64.         next_btn,last_btn,bnk_inf,rec_inf,i,bttn  :       integer;
  65.  
  66. Function GetDrive:short_integer;
  67.   GEMDOS($19);
  68.  
  69. Procedure SetDrive(drive:short_integer);
  70.   GEMDOS($0E);
  71.   
  72. Function MkDir(var folname:C_String):short_integer;
  73.   GEMDOS($39);
  74.  
  75. Procedure change_drive;
  76. Begin
  77.   drive:=GetDrive;
  78.   dummy:=Do_Alert('[0][ Change Drive ][ A | B | C ]',drive+1);
  79.   drive:=dummy-1;
  80.   SetDrive(drive);
  81. end;  
  82.           
  83. Procedure new_data;
  84. var incr : integer;
  85. begin
  86.   for incr:=1 to 14 do
  87.     short_field[incr]:='';
  88.   for incr:=1 to 9 do
  89.     long_field[incr]:='';
  90. end;        
  91.         
  92. Procedure read_pnt_codes;
  93. begin
  94.   fname:='PRINTER.INF';
  95.   Reset(codes,fname);
  96.   test:=IO_Result;
  97.   if test=0 then
  98.     read(codes,pc1,pc2,pc3,pc4);
  99.   if test=-33 then
  100.     begin
  101.       pc1:=0;pc2:=18;pc3:=27;pc4:=15;
  102.       Close(codes);
  103.       Rewrite(codes,fname);
  104.       write(codes,pc1,pc2,pc3,pc4);
  105.       Close(codes);
  106.     end;
  107.   c1:=pc1;
  108.   c2:=pc2;      
  109. end;
  110.  
  111. Procedure bconout(dev, c:integer);
  112. BIOS(3);
  113.  
  114. Procedure build_screen;
  115. begin
  116. end;
  117.  
  118. Procedure build_menu;
  119. var incr:integer;
  120. begin
  121.   Set_Mouse(M_Bee);
  122.   a_menu := New_Menu(134,' Recipe Saver ');
  123.   title0 := Add_MTitle(a_menu,' File ');
  124.   title1 := Add_MTitle(a_menu,' Section 1 ');
  125.   title2 := Add_MTitle(a_menu,' Section 2 ');
  126.   title3 := Add_MTitle(a_menu,' Section 3 ');
  127.   title4 := Add_MTitle(a_menu,' Section 4 ');
  128.   title5 := Add_MTitle(a_menu,' Section 5 ');
  129.   item11 := Add_Mitem(a_menu,title0,'  Quit Program   ');
  130.   item12 := Add_Mitem(a_menu,title0,'-----------------');
  131.   item13 := Add_Mitem(a_menu,title0,'  Print on Paper ');
  132.   item14 := Add_Mitem(a_menu,title0,'  Print 3x5 Card ');
  133.   item15 := Add_Mitem(a_menu,title0,'-----------------');
  134.   item16 := Add_Mitem(a_menu,title0,'  Print Section 1');
  135.   item17 := Add_Mitem(a_menu,title0,'  Print Section 2');
  136.   item18 := Add_Mitem(a_menu,title0,'  Print Section 3');
  137.   item19 := Add_Mitem(a_menu,title0,'  Print Section 4');
  138.   item20 := Add_Mitem(a_menu,title0,'  Print Section 5');
  139.   item21 := Add_Mitem(a_menu,title0,'-----------------');
  140.   item22 := Add_Mitem(a_menu,title0,'  Data Bank A    ');
  141.   item23 := Add_Mitem(a_menu,title0,'  Data Bank B    ');
  142.   item24 := Add_Mitem(a_menu,title0,'-----------------');
  143.   item25 := Add_Mitem(a_menu,title0,'  Change Drive   ');
  144.   for incr:=1 to 20 do
  145.     title[1,incr]:=Add_Mitem(a_menu,title1,m_title[1,incr]);
  146.   for incr:=1 to 20 do
  147.     title[2,incr]:=Add_Mitem(a_menu,title2,m_title[2,incr]);
  148.   for incr:=1 to 20 do
  149.     title[3,incr]:=Add_Mitem(a_menu,title3,m_title[3,incr]);
  150.   for incr:=1 to 20 do
  151.     title[4,incr]:=Add_Mitem(a_menu,title4,m_title[4,incr]);
  152.   for incr:=1 to 20 do
  153.     title[5,incr]:=Add_Mitem(a_menu,title5,m_title[5,incr]);
  154.   Draw_Menu(a_menu);
  155.   Menu_Disable(a_menu,item12);
  156.   Menu_Disable(a_menu,item15);
  157.   Menu_Disable(a_menu,item21);
  158.   if pnttype=Pica then
  159.     begin
  160.       Menu_Check(a_menu,item13,true);
  161.       Menu_Check(a_menu,item14,false);
  162.     end;
  163.   if pnttype=Cond then
  164.     begin
  165.       Menu_Check(a_menu,item13,false);
  166.       Menu_Check(a_menu,item14,true);
  167.     end;
  168.   if bank=0 then
  169.     begin
  170.       Menu_Check(a_menu,item22,true);
  171.       Menu_Check(a_menu,item23,false);
  172.     end;
  173.   if bank=1 then
  174.     begin
  175.       Menu_Check(a_menu,item22,false);
  176.       Menu_Check(a_menu,item23,true);
  177.     end;
  178.   Set_Mouse(M_Arrow);
  179. end;
  180.  
  181.  
  182. Procedure Do_Redraw(handle, x0, y0, w0, h0 : integer);
  183. VAR
  184.   x, y, w, h :integer;
  185.  
  186. begin
  187.   Begin_Update;
  188.   Hide_Mouse;
  189.   First_Rect(handle, x, y, w, h);
  190.   While (w <> 0) and (h <> 0) do
  191.     begin
  192.       If Rect_Intersect( x0, y0, w0, h0, x, y, w, h) then
  193.         begin
  194.           Set_Clip(x, y, w, h);
  195.           Paint_Color(white);
  196.           Paint_Rect(x, y, w, h);
  197.           build_screen;
  198.         end;
  199.       Next_Rect(handle, x, y, w, h);
  200.     end;
  201.   Show_Mouse;
  202.   Set_Clip(xm, ym, wm, hm);
  203.   End_Update;
  204. end;
  205.  
  206. Procedure make_folders;
  207. var incr:integer;
  208. Begin
  209.   for incr:=1 to 5 do
  210.     begin
  211.       flder:='RECIPES ';
  212.       flder[8]:=numstrg[incr,2];
  213.       P_To_Cstr(flder,folname);
  214.       i:=MkDir(folname);
  215.     end;
  216.   test:=-33;
  217. end;
  218.  
  219. Procedure read_titles;
  220. var incr,step,count,ltd:integer;
  221. begin
  222.   Set_Mouse(M_Bee);
  223.   fname2:='\RECIPES \MENU .TXT';
  224.   for incr:=1 to 5 do
  225.     begin
  226.       fname2[9]:=numstrg[incr,2];
  227.       fname2[15]:=numstrg[bank+1,2];
  228.       Reset(disk,fname2);
  229.       test:=IO_Result;
  230.       if test=-33 then
  231.         make_folders; 
  232.       for step:=1 to 20 do
  233.         begin
  234.           if test=0 then
  235.             readln(disk,title_dat[incr,step]);
  236.           if test=-33 then
  237.             title_dat[incr,step]:='';
  238.           m_title[incr,step]:='                    ';
  239.           ltd:=length(title_dat[incr,step]);
  240.           if ltd>0 then
  241.             begin
  242.               if ltd>20 then ltd:=20;
  243.               for count:=1 to ltd do
  244.                 m_title[incr,step,count]:=title_dat[incr,step,count];
  245.             end;    
  246.         end;
  247.       Close(disk);
  248.     end;
  249.   Set_Mouse(M_Arrow);
  250. end;
  251.  
  252. Procedure read_data;
  253. var step:integer;
  254. begin
  255.   Set_Mouse(M_Bee);
  256.   Reset(disk,fname);
  257.   test:=IO_Result;
  258.   if test=0 then
  259.     begin
  260.       for step:=1 to 14 do
  261.         readln(disk,short_field[step]);
  262.       for step:=1 to 9 do
  263.         readln(disk,long_field[step]);
  264.     end;
  265.   if test=-33 then new_data;
  266.   Set_Mouse(M_Arrow);  
  267. end;
  268.  
  269. Procedure save_data;
  270. var incr : integer;
  271. begin
  272.   Set_Mouse(M_Bee);
  273.   Rewrite(disk,fname);
  274.   for incr:=1 to 14 do
  275.     writeln(disk,short_field[incr]);
  276.   for incr:=1 to 9 do
  277.     writeln(disk,long_field[incr]);
  278.   Close(disk);
  279.   fname2:='\RECIPES \MENU .TXT';
  280.   fname2[9]:=numstrg[section,2];
  281.   fname2[15]:=numstrg[bank+1,2];
  282.   Rewrite(disk,fname2);
  283.   for incr:=1 to 20 do
  284.     writeln(disk,title_dat[section,incr]);
  285.   Close(disk);
  286.   Set_Mouse(M_Arrow);
  287. end;
  288.  
  289. Procedure print_data;
  290. var incr,step,ltd : integer;
  291. begin
  292.   Set_Mouse(M_Bee);
  293.   bconout(0,c1);
  294.   bconout(0,c2);
  295.   Rewrite(printer,'LST:');
  296.   ltd:=length(title_dat[section,number]);
  297.   writeln(printer,title_dat[section,number]:37+(ltd div 2));
  298.   if pnttype<>Cond then writeln(printer);
  299.   for incr:=1 to 7 do
  300.     begin
  301.       long_strg:=
  302.       '                                                                          ';
  303.       for step:=1 to length(short_field[incr]) do
  304.         long_strg[step]:=short_field[incr,step];
  305.       for step:=1 to length(short_field[incr+7]) do
  306.         long_strg[step+38]:=short_field[incr+7,step];
  307.       writeln(printer,long_strg);
  308.     end;
  309.   if pnttype<>Cond then writeln(printer);
  310.   for incr:=1 to 9 do
  311.     writeln(printer,long_field[incr]);
  312.   if pnttype<>Cond then
  313.     for incr:=1 to 2 do
  314.       writeln(printer);
  315.   writeln(printer);
  316.   Set_Mouse(M_Arrow);
  317. end;
  318.  
  319. Procedure print_section;
  320. var incr,step: integer;
  321. begin
  322.   for incr:=1 to 20 do
  323.     begin
  324.       number:=incr;
  325.       fname:='\RECIPES \RECIPE  ';
  326.       fname[9]:=numstrg[section,2];
  327.       fname[17]:=numstrg[incr+(20*bank),1];
  328.       fname[18]:=numstrg[incr+(20*bank),2];
  329.       Reset(disk,fname);
  330.       test:=IO_Result;
  331.       if test=0 then
  332.         begin
  333.           for step:=1 to 14 do
  334.             readln(disk,short_field[step]);
  335.           for step:=1 to 9 do
  336.             readln(disk,long_field[step]);
  337.         end;
  338.       if test=-33 then new_data;  
  339.       print_data;
  340.     end;
  341. end;
  342.  
  343. Procedure disp_box;
  344. var incr,step,ltd:integer;
  345. begin
  346.   bnk:='Data Bank  ';
  347.   sect:='Sect   No   ';
  348.   bnk[11]:=chr(bank+ord('A'));
  349.   sect[6]:=numstrg[section,2];
  350.   sect[11]:=numstrg[number,1];
  351.   sect[12]:=numstrg[number,2];
  352.   data_box:=New_Dialog(50,0,0,78,21);
  353.   box:=Add_DItem(data_box,G_Box,None,0,0,78,21,1,4211);
  354.   bnk_inf:=Add_DItem(data_box,G_Text,None,5,1,11,1,0,256);
  355.   Set_DText(data_box,bnk_inf,bnk,sf,TE_Left);
  356.   rec_inf:=Add_DItem(data_box,G_Text,None,60,1,12,1,0,256);
  357.   Set_DText(data_box,rec_inf,sect,sf,TE_Left);  
  358.   efield[24]:=Add_DItem(data_box,G_FText,Editable,20,1,36,1,0,640);
  359.   Set_DEdit(data_box,efield[24],'____________________________________',
  360.   'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',title_dat[section,number],
  361.   sf,TE_Center);
  362.   for incr:=1 to 7 do
  363.     begin
  364.       efield[incr]:=Add_DItem(data_box,G_FText,Editable,2,incr+1,36,1,0,$1180);
  365.       Set_DEdit(data_box,efield[incr],'____________________________________'
  366.       ,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',short_field[incr],sf,TE_Left);
  367.     end;
  368.   for incr:=8 to 14 do
  369.     begin
  370.       efield[incr]:=Add_DItem(data_box,G_FText,Editable,40,incr-6,36,1,0,$1180);
  371.       Set_DEdit(data_box,efield[incr],'____________________________________'
  372.       ,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',short_field[incr],sf,TE_Left);
  373.     end;
  374.   for incr:=15 to 23 do
  375.     begin
  376.       efield[incr]:=Add_DItem(data_box,G_FText,Editable,2,incr-6,74,1,0,$1180);
  377.       Set_DEdit(data_box,efield[incr],
  378.       '__________________________________________________________________________',
  379.       'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
  380.       long_field[incr-14],sf,TE_Left);
  381.     end;
  382.   ex_btn:=Add_DItem(data_box,G_Button,selectable|exit_btn,7,19,6,1,0,$1180);
  383.   Set_DText(data_box,ex_btn,'Exit',smf,TE_Center);
  384.   save_btn:=Add_DItem(data_box,G_Button,selectable|exit_btn,21,19,6,1,0,$1180);
  385.   Set_DText(data_box,save_btn,'Save',smf,TE_Center);
  386.   pnt_btn:=Add_DItem(data_box,G_Button,selectable|exit_btn,35,19,7,1,0,$1180);
  387.   Set_DText(data_box,pnt_btn,'Print',smf,TE_Center);
  388.   next_btn:=Add_DItem(data_box,G_Button,selectable|exit_btn,50,19,6,1,0,$1180);
  389.   Set_DText(data_box,next_btn,'Next',smf,TE_Center);
  390.   last_btn:=Add_DItem(data_box,G_Button,selectable|exit_btn,64,19,6,1,0,$1180);
  391.   Set_DText(data_box,last_btn,'Last',smf,TE_Center);
  392.   Center_Dialog(data_box);
  393.   bttn:=Do_Dialog(data_box,0);
  394.   if bttn=save_btn then
  395.     begin
  396.       for incr:=1 to 14 do
  397.         begin
  398.           Get_DEdit(data_box,efield[incr],teststrg);
  399.           if length(teststrg)=0 then
  400.             teststrg:='';
  401.           if teststrg<>short_field[incr] then
  402.             short_field[incr]:=teststrg;
  403.         end;
  404.       for incr:=15 to 23 do
  405.         begin
  406.           Get_DEdit(data_box,efield[incr],teststrg);
  407.           if length(teststrg)=0 then
  408.             teststrg:='';
  409.           if teststrg<>long_field[incr-14] then
  410.             long_field[incr-14]:=teststrg;
  411.         end;
  412.       Get_DEdit(data_box,efield[24],teststrg);
  413.       if length(teststrg)=0 then
  414.         teststrg:='';
  415.       if teststrg<>title_dat[section,number] then
  416.         begin
  417.           title_dat[section,number]:=teststrg;
  418.           m_title[section,number]:='                    ';
  419.           ltd:=length(title_dat[section,number]);
  420.           if ltd>0 then
  421.             begin
  422.               if ltd>20 then ltd:=20;
  423.               for incr:=1 to ltd do
  424.                 m_title[section,number,incr]:=title_dat[section,number,incr];
  425.             end;
  426.           erase_menu(a_menu);
  427.           delete_menu(a_menu);
  428.           build_menu;
  429.         end;
  430.     end;
  431.   if (bttn=next_btn) and (number<20) then
  432.     begin
  433.       number:=number+1;
  434.       fname[17]:=numstrg[number+(20*bank),1];
  435.       fname[18]:=numstrg[number+(20*bank),2];
  436.       read_data;
  437.     end;
  438.   if (bttn=last_btn) and (number>1) then
  439.     begin
  440.       number:=number-1;
  441.       fname[17]:=numstrg[number+(20*bank),1];
  442.       fname[18]:=numstrg[number+(20*bank),2];
  443.       read_data;
  444.     end;
  445.   End_Dialog(data_box);
  446.   Delete_Dialog(data_box);
  447.   if bttn=save_btn then save_data;
  448.   if bttn=pnt_btn then print_data;
  449. end;
  450.  
  451. Procedure title0_proc;
  452. begin
  453.   if msg[4]=item13 then
  454.     begin
  455.       Menu_Check(a_menu,item13,true);
  456.       Menu_Check(a_menu,item14,false);
  457.       pnttype:=Pica;
  458.       c1:=pc1;
  459.       c2:=pc2;
  460.     end;
  461.   if msg[4]=item14 then
  462.     begin
  463.       Menu_Check(a_menu,item14,true);
  464.       Menu_Check(a_menu,item13,false);
  465.       pnttype:=Cond;
  466.       c1:=pc3;
  467.       c2:=pc4;
  468.     end;
  469.   if msg[4]=item16 then
  470.     begin
  471.       section:=1;
  472.       print_section;
  473.     end;
  474.   if msg[4]=item17 then
  475.     begin
  476.       section:=2;
  477.       print_section;
  478.     end;
  479.   if msg[4]=item18 then
  480.     begin
  481.       section:=3;
  482.       print_section;
  483.     end;
  484.   if msg[4]=item19 then
  485.     begin
  486.       section:=4;
  487.       print_section;
  488.     end;
  489.   if msg[4]=item20 then
  490.     begin
  491.       section:=5;
  492.       print_section;
  493.     end;
  494.   if msg[4]=item22 then
  495.     begin
  496.       bank:=0;
  497.       read_titles;
  498.       Erase_Menu(a_menu);
  499.       Delete_Menu(a_menu);
  500.       build_menu;
  501.       Menu_Check(a_menu,item22,true);
  502.       Menu_Check(a_menu,item23,false);
  503.     end;
  504.   if msg[4]=item23 then
  505.     begin
  506.       bank:=1;
  507.       read_titles;
  508.       Erase_Menu(a_menu);
  509.       Delete_Menu(a_menu);
  510.       build_menu;
  511.       Menu_Check(a_menu,item23,true);
  512.       Menu_Check(a_menu,item22,false);
  513.     end;
  514.   if msg[4]=item25 then
  515.     begin
  516.       change_drive;
  517.       read_titles;
  518.       Erase_Menu(a_menu);
  519.       Delete_Menu(a_menu);
  520.       build_menu;
  521.     end;
  522.   Menu_Normal(a_menu,title0);
  523. end;
  524.  
  525. Procedure title1_proc;
  526. var incr:integer;
  527. begin
  528.   for incr:=1 to 20 do
  529.     if msg[4] = title[1,incr] then
  530.       begin
  531.         section:=1;
  532.         number:=incr;
  533.         fname:='\RECIPES1\RECIPE  ';
  534.         fname[17]:=numstrg[incr+(20*bank),1];
  535.         fname[18]:=numstrg[incr+(20*bank),2];
  536.       end;
  537.   read_data;
  538.   disp_box;
  539.   while bttn<>ex_btn do disp_box;
  540.   Menu_Normal(a_menu,title1);
  541. end;
  542.  
  543. Procedure title2_proc;
  544. var incr:integer;
  545. begin
  546.   for incr:=1 to 20 do
  547.     if msg[4] = title[2,incr] then
  548.       begin
  549.         section:=2;
  550.         number:=incr;
  551.         fname:='\RECIPES2\RECIPE  ';
  552.         fname[17]:=numstrg[incr+(20*bank),1];
  553.         fname[18]:=numstrg[incr+(20*bank),2];
  554.       end;
  555.   read_data;
  556.   disp_box;
  557.   while bttn<>ex_btn do disp_box;
  558.   Menu_Normal(a_menu,title2);
  559. end;
  560.  
  561. Procedure title3_proc;
  562. var incr:integer;
  563. begin
  564.   for incr:=1 to 20 do
  565.     if msg[4] = title[3,incr] then
  566.       begin
  567.         section:=3;
  568.         number:=incr;
  569.         fname:='\RECIPES3\RECIPE  ';
  570.         fname[17]:=numstrg[incr+(20*bank),1];
  571.         fname[18]:=numstrg[incr+(20*bank),2];
  572.       end;
  573.   read_data;
  574.   disp_box;
  575.   while bttn<>ex_btn do disp_box;
  576.   Menu_Normal(a_menu,title3);
  577. end;
  578.  
  579. Procedure title4_proc;
  580. var incr:integer;
  581. begin
  582.   for incr:=1 to 20 do
  583.     if msg[4] = title[4,incr] then
  584.       begin
  585.         section:=4;
  586.         number:=incr;
  587.         fname:='\RECIPES4\RECIPE  ';
  588.         fname[17]:=numstrg[incr+(20*bank),1];
  589.         fname[18]:=numstrg[incr+(20*bank),2];
  590.       end;
  591.   read_data;
  592.   disp_box;
  593.   while bttn<>ex_btn do disp_box;
  594.   Menu_Normal(a_menu,title4);
  595. end;
  596.  
  597. Procedure title5_proc;
  598. var incr:integer;
  599. begin
  600.   for incr:=1 to 20 do
  601.     if msg[4] = title[5,incr] then
  602.       begin
  603.         section:=5;
  604.         number:=incr;
  605.         fname:='\RECIPES5\RECIPE  ';
  606.         fname[17]:=numstrg[incr+(20*bank),1];
  607.         fname[18]:=numstrg[incr+(20*bank),2];
  608.       end;
  609.   read_data;
  610.   disp_box;
  611.   while bttn<>ex_btn do disp_box;
  612.   Menu_Normal(a_menu,title5);
  613. end;
  614.  
  615. Procedure infodial;
  616. begin
  617.   Info_Box := New_Dialog(21,0,0,40,18);
  618.   box:=Add_DItem(Info_Box,G_Box,None,0,0,40,18,1,4211);
  619.   info_item := Add_DItem(Info_Box,G_Text,None,2,1,36,1,0,0);
  620.   Set_DText(Info_Box,info_item,'Recipe Saver',sf,TE_Center);
  621.   info_item := Add_DItem(Info_Box,G_Text,None,2,2,36,1,0,0);
  622.   Set_DText(Info_Box,info_item,'Written in Personal Pascal',sf,TE_Center);
  623.   info_item := Add_DItem(Info_Box,G_Text,None,2,3,36,1,0,0);
  624.   Set_DText(Info_Box,info_item,'by',sf,TE_Center);
  625.   info_item := Add_DItem(Info_Box,G_Text,None,2,4,36,1,0,0);
  626.   Set_DText(Info_Box,info_item,'Lowell Pemberton',sf,TE_Center);
  627.   info_item := Add_DItem(Info_Box,G_Text,None,2,5,36,1,0,0);
  628.   Set_DText(Info_Box,info_item,'3602 S. Webster',sf,TE_Center);
  629.   info_item := Add_DItem(Info_Box,G_Text,None,2,6,36,1,0,0);
  630.   Set_DText(Info_Box,info_item,'Kokomo, IN  46902',sf,TE_Center);
  631.   info_item := Add_DItem(Info_Box,G_Text,None,2,8,36,1,0,0);
  632.   Set_DText(Info_Box,info_item,'(317)453-7052',sf,TE_Center);
  633.   info_item := Add_DItem(Info_Box,G_Text,None,2,9,36,1,0,0);
  634.   Set_DText(Info_Box,info_item,'Compuserve 74030,2023',sf,TE_Center);
  635.   info_item := Add_DItem(Info_Box,G_Text,None,2,11,36,1,0,0);
  636.   Set_DText(Info_Box,info_item,'Portions of this program',
  637.               sf,TE_Center);
  638.   info_item := Add_DItem(Info_Box,G_Text,None,2,12,36,1,0,0);
  639.   Set_DText(Info_Box,info_item,'Copyrighted by OSS & CCD',
  640.               sf,TE_Center);
  641.   info_item := Add_DItem(Info_Box,G_Text,None,2,13,36,1,0,0);
  642.   Set_DText(Info_Box,info_item,'Used by permission of OSS.',
  643.               sf,TE_Center);
  644.   ok_button := Add_DItem(Info_Box,G_Button,Selectable|Exit_Btn|Default,
  645.               17,15,6,2,2,$1180);
  646.   Set_DText(Info_Box,ok_button,'EXIT',sf,TE_Center);
  647.   Center_Dialog(Info_Box);
  648.   ex_btn := Do_Dialog(Info_Box,0);
  649.   End_Dialog(Info_Box);
  650.   Menu_Normal(a_menu,Desk_Title);
  651. end;
  652.  
  653.  
  654. Procedure menu_proc;
  655. begin
  656.   If msg[3] = title0 then
  657.     title0_proc
  658.   ELSE if msg[3] = title1 then
  659.     title1_proc
  660.   ELSE if msg[3] = title2 then
  661.     title2_proc
  662.   ELSE if msg[3] = title3 then
  663.     title3_proc
  664.   ELSE if msg[3] = title4 then
  665.     title4_proc
  666.   ELSE if msg[3] = title5 then
  667.     title5_proc
  668.   ELSE if msg[3] = Desk_Title then
  669.     infodial;
  670. end;
  671.  
  672. Procedure msg_process;
  673. begin
  674.   Case msg[0] of
  675.         MN_Selected     :  If Front_Window = big_window then
  676.                                 menu_proc;
  677.  
  678.         WM_Redraw       :  If msg[3] = big_window then
  679.           Do_Redraw(msg[3],msg[4],msg[5],msg[6],msg[7]);
  680.  
  681.   end;
  682.  
  683. end;
  684.  
  685.  
  686. Procedure event_rtn;
  687. begin
  688.   event := Get_Event(event_val,
  689.                      0,0,0,             { No button goodies     }
  690.                      0,                 { No timer              }
  691.                      False,0,0,0,0,     { No mouse rects        }
  692.                      False,0,0,0,0,
  693.                      msg,
  694.                      dummy,
  695.                      dummy,dummy,       { Not used              }
  696.                      dummy,dummy,
  697.                      dummy
  698.                      );
  699.  
  700.   If (event & E_Message) <> 0 then
  701.     msg_process;
  702.  
  703. end;
  704.  
  705.  
  706.  
  707.  
  708.  
  709. Procedure init;
  710. var incr,step:integer;
  711. begin
  712.   wind_title    := 'RECIPES';
  713.   windtype      := G_Name;
  714.   event_val     := E_Message;
  715.   numstrg[1]:='01';numstrg[2]:='02';numstrg[3]:='03';numstrg[4]:='04';
  716.   numstrg[5]:='05';numstrg[6]:='06';numstrg[7]:='07';numstrg[8]:='08';
  717.   numstrg[9]:='09';numstrg[10]:='10';numstrg[11]:='11';numstrg[12]:='12';
  718.   numstrg[13]:='13';numstrg[14]:='14';numstrg[15]:='15';numstrg[16]:='16';
  719.   numstrg[17]:='17';numstrg[18]:='18';numstrg[19]:='19';numstrg[20]:='20';
  720.   numstrg[21]:='21';numstrg[22]:='22';numstrg[23]:='23';numstrg[24]:='24';
  721.   numstrg[25]:='25';numstrg[26]:='26';numstrg[27]:='27';numstrg[28]:='28';
  722.   numstrg[29]:='29';numstrg[30]:='30';numstrg[31]:='31';numstrg[32]:='32';
  723.   numstrg[33]:='33';numstrg[34]:='34';numstrg[35]:='35';numstrg[36]:='36';
  724.   numstrg[37]:='37';numstrg[38]:='38';numstrg[39]:='39';numstrg[40]:='40';
  725.   IO_Check(false);
  726.   Text_Style(Normal);
  727.   Sys_Font_Size(cw,ch,bw,bh);
  728.   sf:=System_Font;
  729.   smf:=Small_Font;
  730.   Set_Color(3,0,625,625);
  731.   bank:=0;
  732. end;
  733.  
  734.  
  735. Procedure open_wind;
  736. begin
  737.   big_window := New_Window(windtype,wind_title,0,0,0,0);
  738.   Open_Window(big_window,0,0,0,0);
  739.   Work_Rect(0,hx,hy,hw,hh);
  740.   Work_Rect(big_window,xm,ym,wm,hm);
  741. end;
  742.  
  743.  
  744. Procedure eop_processing;
  745. begin
  746.   Close_Window(big_window);
  747.   Delete_Window(big_window);
  748.   Erase_Menu(a_menu);
  749.   Delete_Menu(a_menu);
  750.   Set_Color(3,0,875,0);
  751. end;
  752.  
  753.  
  754. BEGIN
  755.         If Init_Gem >= 0 then
  756.         begin
  757.                 Init_Mouse;
  758.                 Hide_Mouse;
  759.                 Clear_Screen;
  760.                 init;
  761.                 read_pnt_codes;
  762.                 read_titles;
  763.                 build_menu;
  764.                 open_wind;
  765.                 Show_Mouse;
  766.                 Repeat
  767.                   event_rtn
  768.                 Until (msg[0] = WM_Closed) or (msg[4]=item11);
  769.                 eop_processing;
  770.         end;
  771.  
  772.  
  773. end.
  774.